home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / sml_nj / 93src.lha / src / debug / io.sml < prev    next >
Encoding:
Text File  |  1993-01-27  |  3.0 KB  |  103 lines
  1. (* DebugIO
  2.  
  3.    Support "historical" version of IO library. 
  4. *)
  5.  
  6.  
  7.  
  8. signature DEBUG_IO = sig
  9.   val remember: unit -> DebugKernel.doers
  10.   val logit:((unit->'a)*('a->unit)*bool)->'a  
  11. end
  12.  
  13. structure DebugIO: DEBUG_IO = 
  14. struct
  15.   open DebugUtil DebugStatic DebugKernel
  16.  
  17.   type echoer = System.Unsafe.object -> unit
  18.   datatype ioresult = NORMAL of System.Unsafe.object * echoer
  19.                 | EXCEPTION of exn
  20.  
  21.   structure Log = TimedLog(type entry=ioresult)
  22.   val mark = Log.new()
  23.   fun getNext mark = 
  24.       let val (_,entry) = Log.next mark
  25.       in Log.advance mark;
  26.      entry
  27.       end
  28.  
  29.   fun remember () = 
  30.      let val savedMark = Log.copyMark mark
  31.          fun undo _  =  Log.resetMark mark savedMark
  32.      fun redo QUIET = Log.resetMark mark savedMark
  33.        | redo NOISY = 
  34.            (* execute echos for all log entries (advancing currmark) 
  35.           until we hit savedMark! *)
  36.            (dbgprint "+redo\n";
  37.         while (not(Log.equalMarks (mark,savedMark))) do
  38.           (case getNext mark of
  39.              NORMAL (v,g) => g v
  40.            | EXCEPTION _ => ()))
  41.        | redo (BREAK _) =
  42.            debugPanic "IO.can't redo in BREAK mode"
  43.      in {undo=undo,redo=redo}
  44.      end
  45.  
  46.   fun logit (f:unit->'a,g:'a->unit,noisy:bool) :'a = 
  47.     (if noisy then
  48.      let val forced =
  49.            case !execMode of
  50.          RECORD(BREAK _) => true
  51.            | REPLAY(BREAK _) => true
  52.                | _ => false
  53.          in pseudoEvent {forced=forced,evn=pseudoEvn IOev,args=[]}
  54.      end
  55.      else ();
  56.      case (!execMode) of
  57.        RECORD onNoise => 
  58.           (let val v = f()
  59.            in Log.append mark (NORMAL(System.Unsafe.cast v,
  60.                       System.Unsafe.cast g));
  61.           dbgprint ("+app " ^ (makestring (currentTime())) ^ "\n");
  62.           v
  63.                end handle e => 
  64.          (Log.append mark (EXCEPTION e);
  65.           raise e))
  66.      | REPLAY onNoise =>
  67.          ((case Log.get mark of
  68.          NORMAL (v,g') =>  (* expect g = g' *)
  69.              ((case onNoise of
  70.               QUIET => ()
  71.                        | _ =>  (dbgprint ("+redo " ^ 
  72.                       (makestring (currentTime())) ^ "\n");
  73.                 g(System.Unsafe.cast v)));
  74.               System.Unsafe.cast v)
  75.            | EXCEPTION e => raise e)
  76.            handle Log.Logtime(t1,t2) =>
  77.                debugPanic ("IO.logit replay time mismatch" ^
  78.                    (makestring t1) ^ " " ^ (makestring t2)))
  79.       | IGNORE => f()  (* no log *))
  80.  
  81.  
  82. end (* structure *)
  83.  
  84. (* Notes:
  85.  
  86. (1) On replay, appearance of terminal i/o is controlled by the silent flag.
  87. If flag is false, terminal input is echoed to std_out, and terminal
  88. output is performed to std_out. If flag is true, terminal input is not
  89. echoed and terminal output is thrown away.  All non-terminal output is
  90. always thrown away.
  91.  
  92. The choice of std_out for echoing input is somewhat arbitrary.
  93. Using std_out for output too avoids problems
  94. with closed output streams, although it gives the wrong results when
  95. multiple streams are writing to same terminal due to buffering.
  96.  
  97. (2) There may be a problem with exceptions being raised in the middle
  98. of I/O operations: on input, this means no input is returned, but
  99. input pointer may have changed (we get this right); on output, some
  100. output may have occured (we get this wrong to terminals).
  101. *)
  102.  
  103.